(*******************************************************************
This file is part of Geomancian.

Geomancian is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Geomancian is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Geomancian.  If not, see <http://www.gnu.org/licenses/>.
********************************************************************)


(*********************
 * Type definitions. *
 *********************
 *
 * The figure type defines the sequence of dots in a figure as a four-bit 
 * number.  These bits are referred to as the head, neck, body, and feet.  These 
 * have also been referred to as the fire line, air line, water line, and earth 
 * line (respectively) of the figure.
 *
 * The geomanticFigure type defines the relevant information for each of the 
 * sixteen geomantic figures, including the figure sequence itself.
 *)

type figure = {
	head 	: int ;
	neck 	: int ;
	body 	: int ;
	feet 	: int ;
}

type geomanticFigure = {
	name 		: string ;
	eName		: string ;
	figure 		: figure ;
	sum 		: int ;
	parity		: string ;
	mobility 	: string ;
	iElement	: string ;
	oElement	: string ;
	planet 		: string ;
	planetMod	: string ;
	agrippaZ	: string ;
	gerardZ	 	: string ;
	direction 	: string ;
}

(*********************************
 * geomanticFigure declarations. *
 *********************************)

let via = {
	name 		= "Via" ;
	eName		= "Way" ;
	figure		= {head = 1 ; neck = 1 ; body = 1 ; feet = 1 } ;
	sum			= 4 ;
	parity		= "even" ;
	mobility	= "mobile" ;
	iElement	= "water" ;
	oElement	= "water" ;
	planet		= "Moon" ;
	planetMod	= "waning" ;
	agrippaZ	= "Cancer" ;
	gerardZ		= "Leo" ;
	direction	= "away" ;
} 

let pop = {
	name 		= "Populus" ;
	eName		= "People" ;
	figure		= {head = 0 ; neck = 0 ; body = 0 ; feet = 0 } ;
	sum			= 8 ;
	parity		= "even" ;
	mobility	= "stable" ;
	iElement	= "water" ;
	oElement	= "water" ;
	planet		= "Moon" ;
	planetMod	= "waxing" ;
	agrippaZ	= "Cancer" ;
	gerardZ		= "Capricorn" ;
	direction	= "towards" ;
}

let fma = {
	name 		= "Fortuna Major" ;
	eName		= "Greater Fortune" ;
	figure		= {head = 0 ; neck = 0 ; body = 1 ; feet = 1 } ;
	sum			= 6 ;
	parity		= "even" ;
	mobility	= "stable" ;
	iElement	= "earth" ;
	oElement	= "fire" ;
	planet		= "Sun" ;
	planetMod	= "in northern declination" ;
	agrippaZ	= "Leo" ;
	gerardZ		= "Aquarius" ;
	direction	= "northwest" ;
}

let fmi = {
	name 		= "Fortuna Minor" ;
	eName		= "Lesser Fortune" ;
	figure		= {head = 1 ; neck = 1 ; body = 0 ; feet = 0 } ;
	sum			= 6 ;
	parity		= "even" ;
	mobility	= "mobile" ;
	iElement	= "air" ;
	oElement	= "fire" ;
	planet		= "Sun" ;
	planetMod	= "in southern declination" ;
	agrippaZ	= "Leo" ;
	gerardZ		= "Taurus" ;
	direction	= "southeast" ;
}

let acq = {
	name 		= "Acquisitio" ;
	eName		= "Gain" ;
	figure		= {head = 0 ; neck = 1 ; body = 0 ; feet = 1 } ;
	sum			= 6 ;
	parity		= "even" ;
	mobility	= "stable" ;
	iElement	= "air" ;
	oElement	= "fire" ;
	planet		= "Jupiter" ;
	planetMod	= "direct" ;
	agrippaZ	= "Sagittarius" ;
	gerardZ		= "Aries" ;
	direction	= "northeast" ;
} 

let ami = {
	name 		= "Amissio" ;
	eName		= "Loss" ;
	figure		= {head = 1 ; neck = 0 ; body = 1 ; feet = 0 } ;
	sum			= 6 ;
	parity		= "even" ;
	mobility	= "mobile" ;
	iElement	= "fire" ;
	oElement	= "earth" ;
	planet		= "Venus" ;
	planetMod	= "retrograde" ;
	agrippaZ	= "Taurus" ;
	gerardZ		= "Scorpio" ;
	direction	= "southwest" ;
} 

let pur = {
	name 		= "Puer" ;
	eName		= "Boy" ;
	figure		= {head = 1 ; neck = 1 ; body = 0 ; feet = 1 } ;
	sum			= 5 ;
	parity		= "odd" ;
	mobility	= "mobile" ;
	iElement	= "air" ;
	oElement	= "fire" ;
	planet		= "Mars" ;
	planetMod	= "direct" ;
	agrippaZ	= "Aries" ;
	gerardZ		= "Aries" ;
	direction	= "east-northeast or east-southeast" ;
} 

let pla = {
	name 		= "Puella" ;
	eName		= "Girl" ;
	figure		= {head = 1 ; neck = 0 ; body = 1 ; feet = 1 } ;
	sum			= 5 ;
	parity		= "odd" ;
	mobility	= "stable" ;
	iElement	= "water" ;
	oElement	= "air" ;
	planet		= "Venus" ;
	planetMod	= "direct" ;
	agrippaZ	= "Libra" ;
	gerardZ		= "Libra" ;
	direction	= "west-northwest or west-southwest" ;
} 

let alb = {
	name 		= "Albus" ;
	eName		= "White" ;
	figure		= {head = 0 ; neck = 0 ; body = 1 ; feet = 0 } ;
	sum			= 7 ;
	parity		= "odd" ;
	mobility	= "stable" ;
	iElement	= "water" ;
	oElement	= "air" ;
	planet		= "Mercury" ;
	planetMod	= "direct" ;
	agrippaZ	= "Gemini" ;
	gerardZ		= "Cancer" ;
	direction	= "west" ;
} 

let rub = {
	name 		= "Rubeus" ;
	eName		= "Red" ;
	figure		= {head = 0 ; neck = 1 ; body = 0 ; feet = 0 } ;
	sum			= 7 ;
	parity		= "odd" ;
	mobility	= "mobile" ;
	iElement	= "air" ;
	oElement	= "water" ;
	planet		= "Mars" ;
	planetMod	= "retrograde" ;
	agrippaZ	= "Scorpio" ;
	gerardZ		= "Gemini" ;
	direction	= "east" ;
} 

let car = {
	name 		= "Carcer" ;
	eName		= "Prison" ;
	figure		= {head = 1 ; neck = 0 ; body = 0 ; feet = 1 } ;
	sum			= 6 ;
	parity		= "even" ;
	mobility	= "stable" ;
	iElement	= "earth" ;
	oElement	= "earth" ;
	planet		= "Saturn" ;
	planetMod	= "retrograde" ;
	agrippaZ	= "Capricorn" ;
	gerardZ		= "Pisces" ;
	direction	= "downward" ;
} 

let con = {
	name 		= "Conjunctio" ;
	eName		= "Meeting" ;
	figure		= {head = 0 ; neck = 1 ; body = 1 ; feet = 0 } ;
	sum			= 6 ;
	parity		= "even" ;
	mobility	= "mobile" ;
	iElement	= "air" ;
	oElement	= "earth" ;
	planet		= "Mercury" ;
	planetMod	= "retrograde" ;
	agrippaZ	= "Virgo" ;
	gerardZ		= "Virgo" ;
	direction	= "upward" ;
} 

let lae = {
	name 		= "Laetitia" ;
	eName		= "Joy" ;
	figure		= {head = 1 ; neck = 0 ; body = 0 ; feet = 0 } ;
	sum			= 7 ;
	parity		= "odd" ;
	mobility	= "mobile" ;
	iElement	= "fire" ;
	oElement	= "water" ;
	planet		= "Jupiter" ;
	planetMod	= "retrograde" ;
	agrippaZ	= "Pisces" ;
	gerardZ		= "Taurus" ;
	direction	= "north" ;
} 

let tri = {
	name 		= "Tristitia" ;
	eName		= "Sorrow" ;
	figure		= {head = 0 ; neck = 0 ; body = 0 ; feet = 1 } ;
	sum			= 7 ;
	parity		= "odd" ;
	mobility	= "stable" ;
	iElement	= "earth" ;
	oElement	= "air" ;
	planet		= "Saturn" ;
	planetMod	= "direct" ;
	agrippaZ	= "Aquarius" ;
	gerardZ		= "Scorpio" ;
	direction	= "south" ;
} 

let ctd = {
	name 		= "Caput Draconis" ;
	eName		= "Head of the Dragon" ;
	figure		= {head = 0 ; neck = 1 ; body = 1 ; feet = 1 } ;
	sum			= 5 ;
	parity		= "odd" ;
	mobility	= "stable" ;
	iElement	= "earth" ;
	oElement	= "earth" ;
	planet		= "North Node" ;
	planetMod	= "" ;
	agrippaZ	= "Gemini" ;
	gerardZ		= "Virgo" ;
	direction	= "north-northwest or north-northeast" ;
} 

let cad = {
	name 		= "Cauda Draconis" ;
	eName		= "Tail of the Dragon" ;
	figure		= {head = 1 ; neck = 1 ; body = 1 ; feet = 0 } ;
	sum			= 5 ;
	parity		= "odd" ;
	mobility	= "mobile" ;
	iElement	= "earth" ;
	oElement	= "fire" ;
	planet		= "South Node" ;
	planetMod	= "" ;
	agrippaZ	= "Sagittarius" ;
	gerardZ		= "Sagittarius" ;
	direction	= "south-southwest or south-southeast" ;
} 

(*************************
 * Lists of the figures. *
 *************************
 * 
 * The zodiac list combines the figures in a canonical, Zodiac-based order.
 *
 * The impartial and partial lists divide the figures according to parity.  All 
 * figures with an even sum are in the impartial list (and so can appear as 
 * Judges); all figures with an odd sum are in the partial list (and cannot 
 * appear as Judges).
 * 
 * The single and multiple lists divide the partial figures into judges that 
 * have at most one cause (the head line is a single point) or judges that can
 * have many causes (the head line is a double point).  This is used in finding 
 * the Via Puncti.
 *
 * The mobile and stable lists divide the figures according to stability or the 
 * direction of the figure; the mobile figures are also called "exiting" and the 
 * stable figures are also called "entering".  Some sources claim that Via, 
 * Populus, Carcer, and Conjunctio are both entering and exiting (therefore, 
 * both stable and mobile).
 *
 * The binary list is a list of the figures represented as binary numbers, from 
 * 0000 (0x0, 0) as Populus to 1111 (0xF, 15) as Via.
 *
 * The findFigure function takes a function and a figure, and returns the 
 * geomanticFigure that matches the figure in the associated list.  If it isn't 
 * located in the list, it returns its own geomanticFigure (this shouldn't 
 * happen).
 *)

let zodiac		= [ pur ; ami ; alb ; pop ; fma ; con ; 
					pla ; rub ; acq ; car ; tri ; lae ;
					cad ; ctd ; fmi ; via ]
let impartial	= [ fma ; fmi ; via ; pop ; acq ; ami ; car ; con ]
let partial		= [ lae ; tri ; cad ; ctd ; alb ; rub ; pur ; pla ]
let single		= [ via ; fmi ; ami ; car ]
let multiple	= [ pop ; fma ; acq ; con ]
let mobile		= [ fma ; pop ; acq ; car ; tri ; ctd ; alb ; pla ] 
let stable		= [ fmi ; via ; ami ; con ; lae ; cad ; rub ; pur ]
let binary 		= [	pop ; tri ; alb ; fma ; 
					rub ; acq ; con ; ctd ;
					lae ; car ; ami ; pla ;
					fmi ; pur ; cad ; via ]

let fireInner	= [ lae ; ami ; fmi ; cad ]
let fireOuter	= [ pur ; fma ; cad ; acq ]
let airInner	= [ rub ; con ; acq ; pur ]
let airOuter	= [ alb ; pla ; tri ; fmi ]
let waterInner	= [ alb ; pla ; via ; pop ]
let waterOuter	= [ via ; pop ; rub ; lae ]
let earthInner	= [ tri ; car ; fma ; ctd ]
let earthOuter	= [ ami ; con ; car ; ctd ]

let find_figure list f = 
	try
		List.find (fun gf -> gf.figure = f) list
	with Not_found -> 
		List.find (fun gf -> gf.figure = f) zodiac

let find_figure_name list f = 
	try
		List.find (fun gf -> 
			(String.lowercase (gf.name)) = (String.lowercase f)
		) list
	with Not_found -> 
		List.find (fun gf -> 
			(String.lowercase (gf.name)) = (String.lowercase f)
		) zodiac
	
(***************************************
 * Functions for manipulating figures. *
 ***************************************
 * 
 * Inversion of a figure swaps the double points with single points and vice 
 * versa.
 * 
 * Reversion of a figure swaps the head with the feet and the neck with the 
 * body.
 *
 * Conversion of a figure is the same as the combined inversion and reversion 
 * of a figure (the order doesn't matter, as this is a commutative process).
 *
 * Adding two figures requires adding the points together line by line and then 
 * taking the parity of each line.
 *)

let invert f =
	let invertLine i = (if i = 1 then 0 else 1) in
	{
		head	= invertLine f.head ;
		neck	= invertLine f.neck ;
		body	= invertLine f.body ;
		feet 	= invertLine f.feet
	}

let revert f =
	{
		head	= f.feet ;
		neck	= f.body ;
		body	= f.neck ;
		feet	= f.head
	}

let convert f = revert (invert f)

let add r l =
	{
		head 	= (r.head + l.head) mod 2 ;
		neck 	= (r.neck + l.neck) mod 2 ;
		body 	= (r.body + l.body) mod 2 ;
		feet 	= (r.feet + l.feet) mod 2 
	} 

(**************
 * Miscellany *
 **************)

let tPositions = [
	"First Mother"		;
	"Second Mother" 	;
	"Third Mother"		;
	"Fourth Mother"		;
	"First Daughter"	;
	"Second Daughter"	;
	"Third Daughter"	;
	"Fourth Daughter"	;
	"First Niece"		;
	"Second Niece"		;
	"Third Niece"		;
	"Fourth Niece"		;
	"Right Witness"		;
	"Left Witness"		;
	"Judge"				;
	"Sentence" ]

let tShortPositions = [
    "M1"    ;
    "M2"    ;
    "M3"    ;
    "M4"    ;
    "D1"    ;
    "D2"    ;
    "D3"    ;
    "D4"    ;
    "N1"    ;
    "N2"    ;
    "N3"    ;
    "N4"    ;
    "RW"    ;
    "LW"    ;
    "Judge" ;
    "Sentence"  ]

let aPositions = [
	"House I"	;
	"House II"	;
	"House III"	;
	"House IV"	;
	"House V"	;
	"House VI"	;
	"House VII"	;
	"House VIII";
	"House IX"	;
	"House X"	;
	"House XI"	;
	"House XII"	]

let zShPositions = [
	"Ari" ;
	"Tau" ;
	"Gem" ;
	"Can" ;
	"Leo" ;
	"Vir" ;
	"Lib" ;
	"Sco" ;
	"Sag" ;
	"Cap" ;
	"Aqu" ;
	"Pis" ]
